Многозвенная цепь

Используя метод численной интеграции Верле.

Функция расчета положения звеньев

processVertices[vertices_List, fixed_List, bonds_List] := Module[{ coords = vertices[[1]], coords2 = vertices[[2]], coords3 = vertices[[3]] }, Do[ coords3 = coords2; coords2 = coords; Module[{ integrated = 2 coords2 - coords3 + Table[{0,-1}, Length[coords]] 0.001 }, MapThread[Function[{i,j,l,s}, With[{ d = integrated[[i]] - integrated[[j]] },{ norm = Norm[d] },{ m = 0.5 s Min[(l/(norm+0.001) - 1), 0.1] (* чтобы не взорвалось при больших ударах *) }, integrated[[i]] += m d; integrated[[j]] -= m d; ]], RandomSample[bonds]// Transpose]; Map[Function[index, integrated[[index]] = coords[[index]]; ], fixed]; coords = integrated; ]; , {2 5}]; {coords, coords2, coords3} ] Применим на простую систему из 5 звеньев, соединенные бесконечно жесткими пружинами.

---

Формат записи (springs)

{номер вершины 1, номер вершины 2, длина связи, жестскость}

---

Формат записи (fixed)

Определяет номера вершин, которые прибиты гвоздями к стене

---

Проверим

springs = {{1,2,1,1}, {2,3,1,1}, {3,4,1,1}, {4,5,1,1}}; vertices = Table[{i,0}, {i,0,4}]; fixed = {1}; Рассчитаем их новые положения для задонного времени методом итераций FixedPoint

estimate[t_Integer, vertices_, fixed_, springs_] := FixedPoint[Function[x, processVertices[x, fixed, springs] ], { vertices, vertices, vertices }, t]; Анимируем

With[{vertices= vertices, fixed=fixed, springs=springs}, Animate[Graphics[{ Line[estimate[n, vertices, fixed, springs][[1]]] }, PlotRange->{{-5,5}, {-5,5}}], {n, 1, 100, 1}] ]

Разветвленные звенья

Сделаем структуру по сложнее

vertices = {{-0.6864864864864866`,0.7375`},{-0.16756756756756758`,0.7483108108108107`},{0.32432432432432434`,0.764527027027027`},{-0.5675675675675675`,0.6293918918918919`},{-0.22162162162162158`,0.6564189189189189`},{-0.06486486486486487`,0.6672297297297298`},{0.22162162162162158`,0.6726351351351352`},{0.037837837837837895`,0.6131756756756757`},{0.1351351351351351`,0.618581081081081`},{-0.3351351351351352`,0.5969594594594594`},{-0.4378378378378378`,0.591554054054054`},{-0.37837837837837845`,0.5158783783783782`},{0.09189189189189184`,0.5320945945945945`},{-0.30810810810810807`,0.45641891891891895`},{-0.21621621621621623`,0.4131756756756757`},{-0.1027027027027026`,0.4131756756756757`},{0.021621621621621623`,0.4672297297297297`},{-0.15135135135135136`,0.33209459459459456`},{-0.14594594594594584`,0.2564189189189188`},{-0.1405405405405405`,0.17533783783783785`},{-0.12972972972972974`,0.10506756756756758`},{-0.6432432432432433`,0.6888513513513512`},{-0.508108108108108`,0.6077702702702703`},{-0.17837837837837833`,0.7104729729729731`},{-0.2756756756756756`,0.618581081081081`},{-0.00540540540540535`,0.6402027027027026`},{-0.11891891891891898`,0.7050675675675675`},{0.18378378378378368`,0.6402027027027026`},{0.27567567567567575`,0.7266891891891891`},{0.09189189189189184`,0.591554054054054`},{-0.3837837837837838`,0.5699324324324324`},{-0.1567567567567567`,0.3915540540540541`},{-0.34594594594594597`,0.4942567567567568`},{-0.2648648648648648`,0.4402027027027027`},{-0.03783783783783784`,0.4347972972972973`},{0.06486486486486487`,0.4996621621621622`}}; springs = Select[Select[Partition[Flatten[MapIndexed[Function[{pos, index}, Take[SortBy[MapIndexed[Function[{nextPos, nextIndex}, {index[[1]], nextIndex[[1]], Norm[nextPos - pos], 1.0} ], vertices], Function[i, i[[3]]] ], 3] ], vertices]], 4], Function[x, x[[1]] != x[[2]]]], ( #[[3]] < 0.1)&]; fixed = {1,2,3}; Graphics[Table[Line[{vertices[[s[[1]]]], vertices[[s[[2]]]]}], {s, springs}]] Анимируем аналогично

With[{vertices= vertices, fixed=fixed, springs=springs}, Animate[ With[{v = estimate[n, vertices, fixed, springs]}, Graphics[{Blue, Line[Table[{v[[1, s[[1]]]], v[[1, s[[2]]]]}, {s, springs}]], Red, Point[vertices[[fixed]]]}] ], {n, 1, 20, 1}]]